MACup: Giveaway 1996/Image.iso/Shareware & Demos/Web-Publishing/SNAP PrimeBase/PrimeBase™ Server PPC/Setup/Scripts/schema.dal

Text File | 1996-07-14 | 24.5 KB | 1,058 lines | [TEXT/ds30]

declare procedure SchemaHelp()
{
print "Function:    Schema";
print "Author:     Dirk Strack, updated to handle VIEWS by Dieko Jacobi 9/94";
print "Date:        11.6.93 ";
print "Location:    P.INK, Rothenbaumch.5, Hamburg, North-Germany,";
print "Dedicated:    to Iris and all database cowboys.";
print "Description: ";
print "";
print "Schema is a function to print the CREATE statements for a given table name.";
print "the second parameter is optional. if the parameter is omitted, ";
print "schema prints all of the following, if you provide a argument, you can control ";
print "which parts a printed. the characters D, I, R, K, and T define the parts to print.";
print "";
print "    D:    CREATE for simple DOMAINS used with the tables columns.";
print "        CREATE DEFAULTS and RULES on this domains.";
print "        CREATE for composite DOMAINS used to define the tables columns.";
print "    ";
print "    T:    the CREATE table for the given table name.";
print "";
print "    R:    CREATE DEFAULTS and RULES on this table.";
print "";
print "    K:    CREATE for PRIMARY, CANDIDATE KEYS on this table.";
print "        FOREIGN KEYS on this table with explicid and implicid REFERENCES.";
print "        ";
print "    I:    CREATE INDEX on this table.";
print "";
print "";
print "    Examples:";
print "    ";
print '    execute file "Schema" in location "dirk strack:test scripts";';
print "    open database pinkads alias pink;";
print "    ";
print "    /*    print domains used with any table named ads    */";
print '    Schema("ads", "d");';
print "    ";
print "    /*    print all parts of table named ads created by user dbo    */";
print '    Schema("dbo.ads");';
print "";
print "    /*    print all parts of all user tables in the current open database    */";
print "    describe tables;";
print "    for each $cursor Schema(Name);";
print "";
print "    /*    print all parts of all system tables in the current open database    */";
print "    select name from sysobjects ";
print '    where type = "Tab" and creatorname = "System"; ';
print "    for each $cursor Schema(Name);";
print "";
print "xref is a function to print a cross reference list of all columns where ";
print "a given domain is used, or all columns where the domains used in a given table are used.";
print "the function automaticly determinates the type of the given object name.";
print "";
print "    Examples:";
print "    ";
print '    /*    list the usage of domains of table "SysObjects"    */';
print '    xref("SysObjects");';
print "    ";
print '    /*    list the usage if domain "DBObjectID"    */';
print '    xref("DBObjectID");';
print "";
}
end procedure SchemaHelp;

declare int maxcolsize = 20;

declare procedure colsize(c, i)
returns int;
argument cursor c;
argument int    i;
{
    int    len;
    int    nlen;

    len = $colwidth(c,i);
    nlen = $len($colname(c,i));
    if (len < nlen) len = nlen;
    if (len > maxcolsize) len = maxcolsize;

    return len;
}
end procedure colsize;


declare procedure showall(c, size)
argument cursor c = $cursor;
argument int size = 20;
{
    int    i,j;
    int    len;
    maxcolsize = size;

    if ($rowcnt is not null)
        print char[10] $rowcnt + " rows selected";

    print "";

    for (i = 1; i <= $cols(c); i++)
    {
        printf(char[colsize(c, i)] $colname(c,i));
        printf("|");
    }
    print "";
    for (i = 1; i <= $cols(c); i++)
    {
        len = colsize(c, i);
        for (j = 10; j <= len; j = j + 10)
            printf("----------");
        printf($substr("----------", 1, len % 10));
        printf("|");
    }

    print "" ;
    for each c
    {
        for (i = 1; i <= $cols(c); i++)
        {
            len = colsize(c,i);
            if (c->:i is null)
                printf(char[len] "??");
            else
            {
                switch($coltype(c, i))
                {
                    case $boolean:
                    switch (int c->:i)
                    {
                        case 0: printf(char[len] "N");
                        break;
                        case 1: printf(char[len] "Y");
                        break;
                        case 2: printf(char[len] "??");
                        break;
                        case 3: printf(char[len] "!!");
                    }
                    break;
                    case $float:
                    case $smfloat:
                        printf(char[len] (decimal[len,3] c->:i));
                    break;
                    case $timestamp:
                        printf(char[len] (varchar c->:i));
                    break;
                    case $varbin:
                        printf("%*X", size, c->:i);
                    break;
                    default:
                        printf(char[len] c->:i);
                }
            }
            printf("|");
        }
        print "";
    }
}
end procedure showall;

declare procedure NameToID(TableName)
returns cursor;
argument varchar TableName;
{
    varchar    CName, TName;
    cursor    ObjCur;

    if ($locate(TableName, '.') == 0)
    {
        TName    = TableName;

        SELECT    Obj.Type,
                Obj.ID,
                Obj.CreatorName,
                Obj.Name
        FROM    System.SysObjects Obj
        WHERE    Obj.Name    == :TName
        INTO    ObjCur FOR EXTRACT;
    }
    else
    {
        CName    = $left(TableName, '.');
        TName    = $right(TableName, '.');

        SELECT    Obj.Type,
                Obj.ID,
                Obj.CreatorName,
                Obj.Name
        FROM    System.SysObjects Obj
        WHERE    Obj.DBName    == {:CName, :TName}
        INTO    ObjCur FOR EXTRACT;
    }
    fetch next of ObjCur;
    return ObjCur;
}
end procedure NameToID;

declare procedure IDToName(Type, ID)
returns varchar;
argument char[4] Type;
argument integer ID;
{
    cursor    ObjCur;

    select    Obj.Name
    from    SysObjects as Obj
    where    Obj.DBID    == {:Type, :ID}
    into    ObjCur;
    fetch next of ObjCur;
    if ($sqlcode == $sqlnotfound)
        return $null;
    else
        return ObjCur->Name;
}
end procedure IDToName;

declare procedure RuleExpr(ruletext)
returns varchar;
argument varchar ruletext;
{
    varchar buf1, buf2, c;
    integer pos, length;

    pos = $locate($toupper(ruletext), "AS");
    if (pos)
        pos = pos + 3;
    else
    {
        pos = $locate($toupper(ruletext), "CHECK");
        pos = pos + 6;
    }
    buf1 = $substr(ruletext, pos);
    buf1 = $left(buf1, ";");
    length = $len(buf1);
    buf2 = "";
    pos = 1;
    while (pos <= length)
    {
        c = $substr(buf1, pos, 1);
        if ('!' <= c and c <= "z")
            buf2 = buf2 + c;
        else
            buf2 = buf2 + ' ';
        pos++;
    }
    return buf2;
}
end procedure RuleExpr;

declare procedure TypeText(TypeCur)
returns varchar;
argument cursor TypeCur;
{
    varchar text;

    text = TypeCur->TypeName;
    if (TypeCur->TypeWithLength)
    {
        text = text + $format("(%d", TypeCur->Length);
        if (TypeCur->TypeWithScale)
            text = text + $format(",%d)", TypeCur->Scale);
        else
            text = text + $format(")");
    }
    return text;
}
end procedure TypeText;


declare procedure Defaults(ObjCur)
argument cursor ObjCur;
{
    varchar TypeName;

    if (ObjCur->ObjType == "Dom")
        TypeName = "DOMAIN";
    else
        TypeName = "COLUMN";

    if (ObjCur->DefID is not null)
    {
        if (ObjCur->DefType == 'Ser')
        {
            declare cursor TypeCur;

            SELECT    Type.Name                AS TypeName,
                    Type.Scale                AS TypeWithScale,
                    Type.Length                AS TypeWithLength,
                    Var.Scale                AS Scale,
                    Var.Length                AS Length
            FROM    System.SysVariables        AS Var,
                    System.SysDataTypes        AS Type
            WHERE    Var.DBID                == {'Var', ObjCur->DefSerialID}
            AND        Var.DataType            == Type.DataType
            INTO    TypeCur FOR READONLY;

            fetch next of TypeCur;
            if ($sqlcode == 0)
            {
                print "";
                printf("CREATE COUNTER VARIABLE %s %s;",
                    TypeText(TypeCur),
                    IDToName('Var', ObjCur->DefSerialID));
            }
            else
            {
                print "";
                print "/* Error! The COUNTER VARIABLE is missing */";
                printf("CREATE COUNTER VARIABLE INTEGER %s;",
                    IDToName('Var', ObjCur->DefSerialID));
            }
        }
        print "";
        printf("CREATE DEFAULT %s ON %s %s",
            IDToName('Def', ObjCur->DefID), TypeName, ObjCur->ObjectName);
        if (TypeName = "COLUMN")
            printf(".%s", ObjCur->ColumnName);
        printf(" AS ");
        switch(ObjCur->DefType)
        {
            case 'Usr':
                printf("USER");
            break;
            case 'Now':
                printf("NOW");
            break;
            case 'Ser':
                printf("SERIAL %s", IDToName('Var', ObjCur->DefSerialID));
            break;
            case 'Lit':
                switch (ObjCur->DataType)
                {
                    case $boolean:
                        printf("%s", BOOLEAN ObjCur->DefLiteral);
                        break;
                    case $smint:
                        printf("%d", SMINT ObjCur->DefLiteral);
                        break;
                    case $integer:
                        printf("%d", INTEGER ObjCur->DefLiteral);
                        break;
                    case 20: /* $tinyint: */
                        printf("%d", TINYINT ObjCur->DefLiteral);
                        break;
                    case $smfloat:
                        printf("%f", SMFLOAT ObjCur->DefLiteral);
                        break;
                    case $float:
                        printf("%f", FLOAT ObjCur->DefLiteral);
                        break;
                    case $date:
                        printf("'%s'", DATE ObjCur->DefLiteral);
                        break;
                    case $time:
                        printf("'%s'", TIME ObjCur->DefLiteral);
                        break;
                    case $timestamp:
                        printf("'%s'", TIMESTAMP ObjCur->DefLiteral);
                        break;
                    case $char:
                        printf("'%s'", CHAR ObjCur->DefLiteral);
                        break;
                    case $decimal:
                        printf("'%p'", DECIMAL ObjCur->DefLiteral);
                        break;
                    case $money:
                        printf("'%p'", MONEY ObjCur->DefLiteral);
                        break;
                    case $varchar:
                        printf("'%s'", VARCHAR ObjCur->DefLiteral);
                        break;
                }
            break;
        }
        printf(";");
    }
}
end procedure Defaults;

declare procedure Rules(ObjCur)
argument cursor ObjCur;
{
    varchar TypeName;

    if (ObjCur->ObjType == "Dom")
        TypeName = "DOMAIN";
    else
        TypeName = "TABLE";

    if (ObjCur->RuleID is not null)
    {
        print "";
        printf("CREATE RULE   %s", IDToName('Rule', ObjCur->RuleID));
        print "";
        printf("    ON %s %s CHECK %s;",
            TypeName,
            ObjCur->ObjectName,
            RuleExpr(ObjCur->RuleText));
    }
}
end procedure Rules;


declare procedure TableRuleDefault(ID)
argument integer ID;
{
    declare cursor TabCur;

    SELECT    TabObj.Name                AS ObjectName,
            TabObj.Type                AS ObjType,
            Col.Name                AS ColumnName,
            Col.DataType            AS DataType,
            Def.ID                    AS DefID,
            Def.DefaultType            AS DefType,
            Def.Literal                AS DefLiteral,
            Def.SerialID            AS DefSerialID
    FROM    System.SysColumns        AS Col,
            System.SysDefaults        AS Def,
            System.SysObjects        AS TabObj
    WHERE    Col.DBID                == {'Tab', :ID}
    AND        Col.DBColumnID            == Def.DBColumnID
    AND        Col.DBID                == TabObj.DBID
    ORDER    BY ObjectName ASC
    INTO    TabCur FOR READONLY;

    for each TabCur
        Defaults(TabCur);

    SELECT    TabObj.Name                AS ObjectName,
            TabObj.Type                AS ObjType,
            Rule.ID                    AS RuleID,
            Rule.RuleText            AS RuleText
    FROM    System.SysColumns        AS Col,
            System.SysRules            AS Rule,
            System.SysObjects        AS TabObj
    WHERE    Col.DBID                == {'Tab', :ID}
    AND        Col.DBID                == Rule.DBObjectID
    AND        Col.DBID                == TabObj.DBID
    ORDER    BY ObjectName ASC
    INTO    TabCur FOR READONLY;

    for each TabCur
        Rules(TabCur);
}
end procedure TableRuleDefault;


declare procedure SimpleDomains(ID)
argument integer ID;
{
    declare cursor DomCur;
    declare varchar text;
    /*    find the simple domains with are used in the
    **    column definitions of the given table ID
    */

    SELECT    Dom.Primary                AS Primary,
            DomObj.Name                AS ObjectName,
            DomObj.Type                AS ObjType,
            Type.Name                AS TypeName,
            Type.Scale                AS TypeWithScale,
            Type.Length                AS TypeWithLength,
            Dom.DataType            AS DataType,
            Dom.Scale                AS Scale,
            Dom.Length                AS Length,
            Dom.Nulls                AS Nulls,
            Dom.Arithmetic            AS Arithmetic,
            Dom.Ordered                AS Ordered,
            Dom.SequenceID            AS SequenceID,
            Def.ID                    AS DefID,
            Def.DefaultType            AS DefType,
            Def.Literal                AS DefLiteral,
            Def.SerialID            AS DefSerialID,
            Rule.ID                    AS RuleID,
            Rule.RuleText            AS RuleText
    FROM    System.SysDomains        AS Dom,
            System.SysColumns        AS Col,
            System.SysDataTypes        AS Type,
            System.SysObjects        AS DomObj,
            System.SysDefaults        AS Def,
            System.SysRules            AS Rule
    WHERE    Col.DBID                == {'Tab', :ID}
    AND        Col.ColumnID            <  256
    AND        Col.DBDomainID            == Dom.DBID
    AND        Dom.DataType            == Type.DataType
    AND        Dom.DBID                == DomObj.DBID
    AND        Dom.DBID                /= Def.DBObjectID
    AND        Dom.DBID                /= Rule.DBObjectID
    ORDER    BY ObjectName ASC
    INTO    DomCur FOR READONLY;

    for each DomCur
    {
        print "";
        printf("CREATE ");
        if (DomCur->Primary)
            printf("PRIMARY ");
        printf("DOMAIN %s ", DomCur->ObjectName);
        text = TypeText(DomCur);
        printf(text);
        if (not DomCur->Nulls)
            printf(", NOT NULL");
        else
        if (DomCur->Arithmetic)
            printf(", ARITHMETIC APPLICABLE");
        if (not DomCur->Ordered)
            printf(", ORDER NOT APPLICABLE");
        if (DomCur->SequenceID is not null)
            printf(", ORDER AS COLLATING SEQUENCE %s", IDToName('Var', DomCur->SequenceID));
        printf(";");
        Defaults(DomCur);
        Rules(DomCur);
    }
}
end procedure SimpleDomains;

declare procedure CompositeDomains(ID)
argument integer ID;
{
    declare cursor DomCur;
    declare varchar text;
    /*    find the simple domains with are used in the
    **    column definitions of the given table ID
    */
    SELECT    CDom.Primary            AS Primary,
            CDomObj.Name            AS CDomName,
            CDom.ComponentCnt        AS ComponentCnt,
            DomCom.ComponentID        AS ComponentID,
            Type.Name                AS TypeName,
            Type.Scale                AS TypeWithScale,
            Type.Length                AS TypeWithLength,
            DomCom.Scale            AS Scale,
            DomCom.Length            AS Length,
            SDomObj.Name            AS SDomName
    FROM    System.SysColumns        AS Col,
            System.SysDomains        AS CDom,
            System.SysObjects        AS CDomObj,
            System.SysDomainComps    AS DomCom,
            System.SysDataTypes        AS Type,
            System.SysObjects        AS SDomObj
    WHERE    Col.DBID                == {'Tab', :ID}
    AND        Col.ColumnID            >=  256
    AND        Col.DBDomainID            == CDom.DBID
    AND        CDom.DBID                == CDomObj.DBID
    AND        CDom.DBID                == DomCom.DBID
    AND        DomCom.DBDomainID        /= SDomObj.DBID
    AND        DomCom.DataType            /= Type.DataType
    ORDER    BY CDomName ASC, ComponentID ASC
    INTO    DomCur FOR READONLY;

    for each DomCur
    {
        if (DomCur->ComponentID == 1)
        {
            print "";
            printf("CREATE ");
            if (DomCur->Primary)
                printf("PRIMARY ");
            printf("DOMAIN %s (", DomCur->CDomName);
        }
        else
            printf(", ");
        if (DomCur->SDomName is not null)
            text = DomCur->SDomName;
        else
            text = TypeText(DomCur);
        printf(text);
        if (DomCur->ComponentCnt == DomCur->ComponentID)
            printf(");");
    }
}
end procedure CompositeDomains;

declare procedure Indices(ID)
argument integer ID;
{
    declare cursor    IndCur;
    declare    integer PrevID;

    SELECT    Ind.ID                        AS ID,
            Ind.ComponentID                AS Component,
            Tab.Name                    AS TableName,
            Obj.Name                    AS IndexName,
            Col.Name                    AS ColumnName
    FROM    System.SysIndexComps        AS Ind,
            System.SysObjects            AS Tab,
            System.SysObjects            AS Obj,
            System.SysColumns            AS Col
    WHERE    Ind.DBTableID                == {'Tab', :ID}
    AND        Ind.DBTableID                == Tab.DBID
    AND        Ind.DBColumnID                == Col.DBColumnID
    AND        Ind.DBID                    == Obj.DBID
    ORDER     BY ID ASC, Component ASC
    INTO    IndCur FOR EXTRACT;

    PrevID            = 0;
    for each IndCur
    {
        if (IndCur->ID != PrevID)
        {
            if (PrevID != 0)
                printf (");");
            print "";
            printf("CREATE INDEX %s ON %s (",
                IndCur->IndexName, IndCur->TableName);
        }
        if (IndCur->Component != 1)
            printf(", ");
        printf (IndCur->ColumnName);
        PrevID    = IndCur->ID;
    }
    if (PrevID != 0)
        printf (");");
}
end procedure Indices;


declare procedure SimpleColumns(ID)
argument integer ID;
{
    declare cursor ColCur;
    declare varchar text;

    SELECT    Col.ColumnID            AS ColumnID,
            Col.Name                AS ColName,
            Col.Nulls                AS ColNulls,
            Col.Scale                AS Scale,
            Col.Length                AS Length,
            Dom.Name                AS DomName,
            Type.Name                AS TypeName,
            Type.Scale                AS TypeWithScale,
            Type.Length                AS TypeWithLength
    FROM    System.SysColumns        AS Col,
            System.SysObjects        AS Dom,
            System.SysDataTypes        AS Type
    WHERE    Col.DBID                == {'Tab', :ID}
    AND        Col.ColumnID            <  256
    AND        Col.DBDomainID            /= Dom.DBID
    AND        Col.DataType            /= Type.DataType
    ORDER    BY ColumnID ASC
    INTO    ColCur FOR READONLY;

    for each ColCur
    {
        if (ColCur->ColumnID != 1)
            printf(",");
        print "";
        printf("    %-20s ", ColCur->ColName);
        if (ColCur->DomName is not null)
            text = ColCur->DomName;
        else
            text = TypeText(ColCur);
        printf("%-20s ", text);
        if (ColCur->ColNulls)
            printf(" NULL");
        else
            printf(" NOT NULL");
    }
}
end procedure SimpleColumns;


declare procedure CompositeColumns(ID)
argument integer ID;
{
    declare cursor ColCur;
    declare varchar text;

    SELECT    Comp.ColumnID            AS ColumnID,
            Comp.ComponentID        AS ComponentID,
            CCol.Name                AS CColName,
            CCol.ComponentCnt        AS ComponentCnt,
            SCol.Name                AS SColName,
            CDom.Name                AS DomName
    FROM    System.SysColumnComps    AS Comp,
            System.SysColumns        AS CCol,
            System.SysColumns        AS SCol,
            System.SysObjects        AS CDom
    WHERE    Comp.Type                == 'Tab'
    AND        Comp.ID                    == :ID
    AND        Comp.DBColumnID            == CCol.DBColumnID
    AND        Comp.DBCompColID        == SCol.DBColumnID
    AND        CCol.DBDomainID            /= CDom.DBID
    ORDER     BY ColumnID ASC, ComponentID ASC
    INTO    ColCur FOR READONLY;

    for each ColCur
    {
        if (ColCur->ComponentID == 1)
        {
            printf(",");
            print "";
            printf("    %-20s (", ColCur->CColName);
        }
        else
            printf(", ");
        printf(ColCur->SColName);
        if (ColCur->ComponentID == ColCur->ComponentCnt)
        {
            if (ColCur->DomName is not null)
                printf(") %s", ColCur->DomName);
            else
                printf(")");
        }
    }
}
end procedure CompositeColumns;

declare procedure Keys(ID)
argument integer ID;
{
    declare cursor    KeyCur, RefCur;
    declare varchar    TypeName;

    /*    print the create statements for PRIMARY and CANDIDATE keys of table ID    */
    SELECT    Cols.Name                AS ColName,
            KeyObj.Name                AS KeyName,
            Keys.KeyType             AS KeyType,
            TabObj.Name                AS TabName
    FROM    System.SysKeys            AS Keys,
            System.SysObjects        AS KeyObj,
            System.SysObjects        AS TabObj,
            System.SysColumns        AS Cols
    WHERE    Keys.DBTableID            == {'Tab', :ID}
    AND        Keys.KeyType            IN ('Pk','Ck')
    AND        Keys.DBID                == KeyObj.DBID
    AND        Keys.DBTableID            == TabObj.DBID
    AND        Keys.DBColumnID         == Cols.DBColumnID
    ORDER     BY KeyType DESC
    INTO    KeyCur FOR READONLY;

    for each KeyCur
    {
        if (KeyCur->KeyType == 'Pk')
            TypeName = "PRIMARY";
        else
            TypeName = "CANDIDATE";
        print "";
        printf("CREATE %s KEY %s ON %s.%s;",
                :TypeName, KeyCur->KeyName, KeyCur->TabName, KeyCur->ColName);
    }
    /*    print the create statements for FOREIGN keys of table ID    */
    SELECT    Keys.ID                    AS KeyID,
            Keys.ReferenceCnt        AS ReferenceCnt,
            Keys.DBColumnID,
            Cols.Name                AS ColName,
            KeyObj.Name                AS KeyName,
            Keys.UpdateAction        AS UpdateAction,
            Keys.DeleteAction        AS DeleteAction,
            TabObj.Name                AS TabName
    FROM    System.SysKeys            AS Keys,
            System.SysObjects        AS KeyObj,
            System.SysObjects        AS TabObj,
            System.SysColumns        AS Cols
    WHERE    Keys.DBTableID            == {'Tab', :ID}
    AND        Keys.KeyType            == 'Fk'
    AND        Keys.DBID                == KeyObj.DBID
    AND        Keys.DBTableID            == TabObj.DBID
    AND        Keys.DBColumnID         == Cols.DBColumnID
    ORDER     BY KeyID ASC
    INTO    KeyCur FOR READONLY;

    for each KeyCur
    {
        print "";
        printf("CREATE FOREIGN KEY %s ON %s.%s",
                KeyCur->KeyName, KeyCur->TabName, KeyCur->ColName);
        if (KeyCur->ReferenceCnt)
        {
            /*    get explicit defined references    */
            SELECT    Refs.ReferenceID        AS RefID,
                    TabObj.Name                AS TabName
            FROM    System.SysReferences    AS Refs,
                    System.SysObjects        AS TabObj
            WHERE    Refs.DBID                == {'Key', KeyCur->KeyID}
            AND        Refs.DBTableID            == TabObj.DBID
            ORDER     BY RefID ASC
            INTO    RefCur FOR READONLY;

            printf(" REFERENCES ");
            for each RefCur
            {
                if (RefCur->RefID != 1)
                    printf(", ");
                printf(RefCur->TabName);
            }
        }
        else
        {
            declare boolean first = $true;
            /*    get implicit defined references    */
            /*    find a table where the domain of the primary key column is equal
            **    to the domain of the foreign key column.
            **
            */
            SELECT    TabObj.Name                AS TabName
            FROM    System.SysColumns        AS FKCols,
                    System.SysKeys            AS PKeys,
                    System.SysColumns        AS PKCols,
                    System.SysObjects        AS TabObj
            WHERE    FKCols.DBColumnID        == {KeyCur->TableType, KeyCur->TableID, KeyCur->ColumnID}
            AND        FKCols.DBDomainID        == PKCols.DBDomainID
            AND        PKCols.DBColumnID        == PKeys.DBColumnID
            AND        PKeys.KeyType            == 'Pk'
            AND        PKeys.DBTableID            == TabObj.DBID
            INTO    RefCur FOR READONLY;

            printf(" /* (IMPLICITLY) REFERENCES ");
            for each RefCur
            {
                if (not first)
                    printf(", ");
                first = $false;
                printf(RefCur->TabName);
            }
            printf(" */");
        }


        if (KeyCur->UpdateAction != 'Rest')
        {
            printf(" ON UPDATE ");
            switch(KeyCur->UpdateAction)
            {
                case 'Casc': printf("CASCADE"); break;
                case 'Null': printf("SET NULL"); break;
                case 'Def':  printf("SET DEFAULT"); break;
            }
        }
        if (KeyCur->DeleteAction != 'Rest')
        {
            printf(" ON DELETE ");
            switch(KeyCur->DeleteAction)
            {
                case 'Casc': printf("CASCADE"); break;
                case 'Null': printf("SET NULL"); break;
                case 'Def':  printf("SET DEFAULT"); break;
            }
        }
        printf(";");
    }
}
end procedure Keys;


declare procedure ShowViewText(ID)
argument integer ID;
{
    declare cursor    ViewCur;
    varchar vt;
    integer pos = 0, br = 0;

    SELECT    Viewtext
    FROM    System.SysViews
    WHERE    SysViews.ID    == :ID
    INTO    ViewCur FOR EXTRACT;
    fetch next of ViewCur;

    print "";
    vt = $toupper(ViewCur->ViewText);

    if($locate(vt, $format("\r")) != 0 or $locate(vt, $format("\n")) != 0)
    {
        /*
        If the view contains carriage returns,
        we assume that it does not need formatting
        */
        printf(vt);
        return;
    }

    printf("CREATE VIEW ");

    pos = $locate(vt, "VIEW");
    vt = $ltrim($substr(vt, pos+4));
    pos = $locate(vt, "AS ");
    printf($substr(vt, 1, pos+1));
    print "";
    vt = $ltrim($substr(vt, pos+3));
    pos = $locate(vt, "FROM ");
    printf($substr(vt, 1, pos-1));
    print "";
    vt = $ltrim($substr(vt, pos));
    pos = $locate(vt, "WHERE");
    if(pos = 0)
        printf(vt);
    else
    {
        /*
        This loop doesn't check for brackets,
        every AND will start a new line
        */
        while (pos > 0)
        {
            printf($substr(vt, 1, pos-1));
            vt = $ltrim($substr(vt, pos));
            pos = $locate(vt, " AND");
            if(pos > 0)
                print "";
        }
        print "";
        printf(vt);
    }
}
end procedure ShowViewText;


declare procedure Schema(Name, args)
argument varchar Name = "";            /*    Name of a exiting table    */
argument varchar args = "DIRKT";        /*    list of arguments        */
{
    declare
    varchar    Type;
    integer    ID, IsView = 0;
    cursor    ObjCur;

    if(Name = "")
    {
        SchemaHelp();
        return;
    }

    ObjCur = NameToID(:Name);
    if ($rows(ObjCur) == 0)
    {
        print "The object '" + :Name + "' does not exist";
        return;
    }
    if (ObjCur->Type != 'Tab')
    {
        if(ObjCur->Type == 'View')
            IsView = 1;
        else
            return;
    }

    ID     = ObjCur->ID;
    Name= ObjCur->CreatorName+"."+ObjCur->Name;

    DESELECT ObjCur;

    print "";
    print "";
    printf ("/******** %s ********/", :Name);

    if (IsView = 1)
        ShowViewText(:ID);
    else
    {
        args = $toupper(args);
        if ($locate(args, "D") != 0)
        {
            SimpleDomains(:ID);
            CompositeDomains(:ID);
        }
        if ($locate(args, "T") != 0)
        {
            print "";
            print "";
            printf("CREATE TABLE %s ", :Name);
            print "";
            printf ("(");
            SimpleColumns(:ID);
            CompositeColumns(:ID);
            print "";
            printf(");");
        }
        if ($locate(args, "K") != 0)
            Keys(:ID);
        if ($locate(args, "R") != 0)
            TableRuleDefault(:ID);
        if ($locate(args, "I") != 0)
            Indices(:ID);
    }
    print "";
}
end procedure Schema;


declare procedure xref(Name, primaryonly)
argument varchar Name  = $null;
argument boolean primaryonly = $false;
{
    cursor    ObjCur;

    ObjCur = NameToID(:Name);
    if ($rows(ObjCur) == 0)
        return;
    if (ObjCur->Type == 'Tab')
    {
        if (primaryonly)
        {
            SELECT    DomObj.Name            AS DomainName,
                    Keys.KeyType        AS Key,
                    TabObjB.Name        AS TableName,
                    ColB.Name            AS ColumnName
            FROM
                    System.SysKeys        AS PKeys,            /*    Primary keys                */
                    System.SysColumns    AS ColC,            /*    Columns of primary keys        */
                    System.SysColumns    AS ColA,            /*    Columns of given table    */
                    System.SysDomains    AS Dom,
                    System.SysObjects    AS DomObj,
                    System.SysColumns    AS ColB,            /*    Columns of tables with same domain    */
                    System.SysObjects    AS TabObjB,
                    System.SysKeys        AS Keys
            WHERE    ColA.DBID            == {ObjCur->Type, ObjCur->ID}
            AND        ColA.DBDomainID        == Dom.DBID
            AND        Dom.DBID            == DomObj.DBID
            AND        ColB.DBDomainID        == Dom.DBID
            AND        ColB.DBID            == TabObjB.DBID
            AND        ColB.DBColumnID        /= Keys.DBColumnID
            AND        PKeys.KeyType        == 'Pk'
            AND        PKeys.DBColumnID    == ColC.DBColumnID
            AND        ColC.DBDomainID        == ColA.DBDomainID
            ORDER BY DomainName, Key DESC, TableName, ColumnName
            INTO    ObjCur FOR EXTRACT;
        }
        else
        {
            SELECT    DomObj.Name            AS DomainName,
                    Keys.KeyType        AS Key,
                    TabObjB.Name        AS TableName,
                    ColB.Name            AS ColumnName
            FROM
                    System.SysColumns    AS ColA,            /*    Columns of given table    */
                    System.SysDomains    AS Dom,
                    System.SysObjects    AS DomObj,
                    System.SysColumns    AS ColB,            /*    Columns of tables with same domain    */
                    System.SysObjects    AS TabObjB,
                    System.SysKeys        AS Keys
            WHERE    ColA.DBID            == {ObjCur->Type, ObjCur->ID}
            AND        ColA.DBDomainID        == Dom.DBID
            AND        Dom.DBID            == DomObj.DBID
            AND        ColB.DBDomainID        == Dom.DBID
            AND        ColB.DBID            == TabObjB.DBID
            AND        ColB.DBColumnID        /= Keys.DBColumnID
            ORDER BY DomainName, Key DESC, TableName, ColumnName
            INTO    ObjCur FOR EXTRACT;
        }
        showall(ObjCur);
    }
    else if (ObjCur->Type == 'Dom')
    {
        SELECT    ObjCur->Name        AS DomainName,
                Keys.KeyType        AS Key,
                TabObjB.Name        AS TableName,
                ColB.Name            AS ColumnName
        FROM    System.SysColumns    AS ColB,
                System.SysObjects    AS TabObjB,
                System.SysKeys        AS Keys
        WHERE    ColB.DBDomainID        == {ObjCur->Type, ObjCur->ID}
        AND        ColB.DBID            == TabObjB.DBID
        AND        ColB.DBColumnID        /= Keys.DBColumnID
        ORDER BY Key DESC, TableName, ColumnName
        INTO    ObjCur FOR EXTRACT;
        showall(ObjCur);
    }
}
end procedure xref;
/*schema("");*/